home *** CD-ROM | disk | FTP | other *** search
/ Delphi Magazine Collection 2001 / Delphi Magazine Collection 20001 (2001).iso / DISKS / Issue62 / Alfresco / AAHpDist.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  2000-09-03  |  3.8 KB  |  138 lines
  1. {*********************************************************}
  2. {* AAHpDist                                              *}
  3. {* Copyright (c) Julian M Bucknall 2000                  *}
  4. {* All rights reserved.                                  *}
  5. {*********************************************************}
  6. {* Algorithms Alfresco: Heap allocation distributions    *}
  7. {*********************************************************}
  8.  
  9. {Note: this unit is released as freeware. In other words, you are free
  10.        to use this unit in your own applications, however I retain all
  11.        copyright to the code. JMB}
  12.  
  13. unit AAHpDist;
  14.  
  15. {WARNING: this unit *must* appear first in your project's uses list.}
  16.  
  17. interface
  18.  
  19. const
  20.   aaHeapAlign = 4;
  21.     {-the alignment value for the heap}
  22.   aaHeapMinAlloc = 8;
  23.     {-the minimum allocation in bytes (exluding Size/Flags value)}
  24.   aaHeapMaxAlloc = 512;
  25.     {-the maximum allocation in bytes to track}
  26.  
  27. type
  28.   TaaHeapBins =
  29.      array [aaHeapMinAlloc div aaHeapAlign ..
  30.             succ(aaHeapMaxAlloc div aaHeapAlign)] of integer;
  31.  
  32. var
  33.   aaHeapBins : TaaHeapBins;
  34.  
  35. implementation
  36.  
  37. uses
  38.   Windows, // it's OK to use Windows: it allocates no memory
  39.   AANoMem;
  40.  
  41. var
  42.   OrigHeap : TMemoryManager;
  43.   OurHeap  : TMemoryManager;
  44.  
  45. procedure UpdateBin(Size : integer);
  46. var
  47.   RoundedSize : integer;
  48. begin
  49.   {calculate the rounded size of the requested allocation; this is..}
  50.   {..the actual size rounded up to the nearest aaHeapAlign bytes (4)}
  51.   RoundedSize := (Size + aaHeapAlign - 1) and (not (integer(aaHeapAlign) - 1));
  52.   {..if the result is less than the minimum round up to the minimum}
  53.   if (RoundedSize < aaHeapMinAlloc) then
  54.     RoundedSize := aaHeapMinAlloc
  55.   {..if greater than the maximum round down to the maximum plus 4 (in other
  56.    words, this allocation is for the 'other' bin)}
  57.   else if (RoundedSize > aaHeapMaxAlloc) then
  58.     RoundedSize := aaHeapMaxAlloc + aaHeapAlign;
  59.  
  60.   {increment the count in the relevant bin}
  61.   InterlockedIncrement(aaHeapBins[RoundedSize div aaHeapAlign]);
  62. end;
  63.  
  64. function OurGetMem(Size : integer) : pointer;
  65. begin
  66.   {update the relevant bin}
  67.   UpdateBin(Size);
  68.   {go ahead and allocate the memory}
  69.   Result := OrigHeap.GetMem(Size);
  70. end;
  71.  
  72. function OurReallocMem(P : pointer; Size : integer) : pointer;
  73. begin
  74.   {update the relevant bin; note: Size=0 is the same as a FreeMem}
  75.   if (Size <> 0) then
  76.     UpdateBin(Size);
  77.   {go ahead and do the work}
  78.   Result := OrigHeap.ReallocMem(P, Size)
  79. end;
  80.  
  81. procedure InitializeUnit;
  82. begin
  83.   {get the original manager}
  84.   GetMemoryManager(OrigHeap);
  85.  
  86.   {set up our heap manager}
  87.   OurHeap.GetMem := OurGetMem;
  88.   OurHeap.FreeMem := OrigHeap.FreeMem;
  89.   OurHeap.ReallocMem := OurReallocMem;
  90.  
  91.   {fill all bins with zeros}
  92.   FillChar(aaHeapBins, sizeof(aaHeapBins), 0);
  93.  
  94.   {replace heap manager with ours}
  95.   SetMemoryManager(OurHeap);
  96. end;
  97.  
  98. procedure FinalizeUnit;
  99. var
  100.   Log : System.Text;
  101.   i   : integer;
  102.   LogNameZ : array [0..255] of char;
  103.   LogName  : shortstring;
  104. begin
  105.   {restore the original manager}
  106.   SetMemoryManager(OrigHeap);
  107.  
  108.   {get the log name}
  109.   aaReadRegistryString(LogNameZ, 256,
  110.                        'software\AlgorithmsAlfresco\AAHpDist',
  111.                        'LogName',
  112.                        'C:\HEAPDIST.LOG');
  113.   LogName := aaStrPas(LogNameZ);
  114.  
  115.   {write out data to log}
  116.   aaLogOpen(Log, LogName);
  117.   try
  118.     writeln(Log, 'Heap Allocation Distribution');
  119.     writeln(Log, '----------------------------');
  120.     writeln(Log);
  121.     writeln(Log, 'Size':5, 'Count':10);
  122.     for i := low(aaHeapBins) to pred(high(aaHeapBins)) do
  123.       writeln(Log, (i * aaHeapAlign):5, aaHeapBins[i]:10);
  124.     writeln(Log, 'Other':5, aaHeapBins[high(aaHeapBins)]:10);
  125.   finally
  126.     aaLogClose(Log);
  127.   end;
  128. end;
  129.  
  130.  
  131. initialization
  132.   InitializeUnit;
  133.  
  134. finalization
  135.   FinalizeUnit;
  136.  
  137. end.
  138.